home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / libs / svgapb23 / svgamod2.bas < prev    next >
Encoding:
BASIC Source File  |  1995-01-19  |  37.3 KB  |  1,211 lines
  1. '****************************************************************************
  2. '*
  3. '*      'SVGAPB' A Super VGA Graphics Librarys for use with 
  4. '*      Power Basic Inc's Power BASIC 3.00c and later
  5. '*      Copyright 1993-1995 by Stephen L. Balkum and Daniel A. Sill
  6. '*
  7. '*      Power BASIC is a registered trademark of Power BASIC Inc.
  8. '*
  9. '*    **************** UNREGISTERED SHAREWARE VERSION **********************
  10. '*    * FOR EVALUATION ONLY. NOT FOR RESALE IN ANY FORM. SOFTWARE WRITTEN  *
  11. '*    * USING THIS UNREGISTERED SHAREWARE GRAPHICS LIBRARY MAY NOT BY SOLD *
  12. '*    * OR USED FOR ANY PURPOSE OTHER THAN THE EVALUATION OF THIS LIBRARY. *
  13. '*    **********************************************************************
  14. '*
  15. '*    **************** NO WARRANTIES AND NO LIABILITY **********************
  16. '*    * Stephen L. Balkum and Daniel A. Sill provide no warranties, either *
  17. '*    * expressed or implied, of merchant ability, or fitness, for a       *
  18. '*    * particular use or purpose of this SOFTWARE and documentation.      *
  19. '*    * In no event shall Stephen L. Balkum or Daniel A. Sill be held      *
  20. '*    * liable for any damages resulting from the use or misuse of the     *
  21. '*    * SOFTWARE and documentation.                                        *
  22. '*    **********************************************************************
  23. '*
  24. '*    ************** U.S. GOVERNMENT RESTRICTED RIGHTS *********************
  25. '*    * Use, duplication, or disclosure of the SOFTWARE and documentation  *
  26. '*    * by the U.S. Government is subject to the restrictions as set forth *
  27. '*    * in subparagraph (c)(1)(ii) of the Rights in Technical Data and     *
  28. '*    * Computer Software clause at DFARS 252.227-7013.                    *
  29. '*    * Contractor/manufacturer is Stephen L. Balkum and Daniel A. Sill,   *
  30. '*    * P.O. Box 7704, Austin, Texas 78713-7704                            *
  31. '*    **********************************************************************
  32. '*
  33. '*    **********************************************************************
  34. '*    * By using this SOFTWARE or documentation, you agree to the above    *
  35. '*    * terms and conditions.                                              *
  36. '*    **********************************************************************
  37. '*
  38. '****************************************************************************
  39.  
  40.  
  41.     $INCLUDE "SVGAPB.BI"
  42.     $INCLUDE "SVGADEMO.BI"
  43.  
  44.     DEFINT A-Z
  45.     
  46.     
  47.     SUB DO2D (RET$)
  48.     
  49.     DIM POINTARRY(0 TO 8) AS P2DType
  50.  
  51.     '*************************************************************************
  52.     '* SET UP THE TITLE
  53.     '*************************************************************************
  54.     TITLE$ = "DEMO 11: 2D functions"
  55.     PALSET PAL(0), 0, 255
  56.  
  57.     '*************************************************************************
  58.     '* SET UP THE 'STAR' PATTERN OF POINTS
  59.     '*************************************************************************
  60.     SETVIEW 0, 0, GETMAXX, GETMAXY
  61.     CNTX = GETMAXX \ 2
  62.     CNTY = ((GETMAXY - 32) \ 2) + 32
  63.     SPCNG = GETMAXX \ 30
  64.     POINTARRY(0).X = 0
  65.     POINTARRY(0).Y = -SPCNG * 6
  66.     POINTARRY(1).X = SPCNG * 2
  67.     POINTARRY(1).Y = -SPCNG * 2
  68.     POINTARRY(2).X = SPCNG * 6
  69.     POINTARRY(2).Y = 0
  70.     POINTARRY(3).X = SPCNG * 2
  71.     POINTARRY(3).Y = SPCNG * 2
  72.     POINTARRY(4).X = 0
  73.     POINTARRY(4).Y = SPCNG * 6
  74.     POINTARRY(5).X = -SPCNG * 2
  75.     POINTARRY(5).Y = SPCNG * 2
  76.     POINTARRY(6).X = -SPCNG * 6
  77.     POINTARRY(6).Y = 0
  78.     POINTARRY(7).X = -SPCNG * 2
  79.     POINTARRY(7).Y = -SPCNG * 2
  80.     POINTARRY(8).X = 0
  81.     POINTARRY(8).Y = -SPCNG * 6
  82.  
  83.     '*************************************************************************
  84.     '* SHOW D2TRANSLATE
  85.     '*************************************************************************
  86.     FILLSCREEN 0
  87.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  88.     A$ = "D2TRANSLATE (Points,XTrans,YTrans,InAry,OutAry)"
  89.     DRWSTRING 1, 7, 0, A$, 10, 16
  90.     SETVIEW 0, 32, GETMAXX, GETMAXY
  91.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  92.     SHOWSTAR
  93.     GETKEY RET$
  94.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  95.         FILLSCREEN 0
  96.         SETVIEW 0, 0, GETMAXX, GETMAXY
  97.         EXIT SUB
  98.     END IF
  99.     XTRANS = 0
  100.     YTRANS = 0
  101.     FOR J = 0 TO SPCNG * 2
  102.         XTRANS = XTRANS + 2
  103.         YTRANS = YTRANS + 2
  104.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  105.         SHOWSTAR
  106.         SDELAY 2
  107.     NEXT J
  108.     FOR J = 0 TO SPCNG * 2
  109.         XTRANS = XTRANS - 2
  110.         YTRANS = YTRANS - 2
  111.         D2TRANSLATE 9, CNTX + XTRANS, CNTY + YTRANS, POINTARRY(0).X, PLOTARRY(0).X
  112.         SHOWSTAR
  113.         SDELAY 2
  114.     NEXT J
  115.     GETKEY RET$
  116.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  117.         FILLSCREEN 0
  118.         SETVIEW 0, 0, GETMAXX, GETMAXY
  119.         EXIT SUB
  120.     END IF
  121.  
  122.     '*************************************************************************
  123.     '* SHOW D2SCALE
  124.     '*************************************************************************
  125.     SETVIEW 0, 0, GETMAXX, 31
  126.     FILLVIEW 0
  127.     SETVIEW 0, 0, GETMAXX, GETMAXY
  128.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  129.     A$ = "D2SCALE (Points,XScale,YScale,InAry,OutAry)"
  130.     DRWSTRING 1, 7, 0, A$, 10, 16
  131.     SETVIEW 0, 32, GETMAXX, GETMAXY
  132.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  133.     SHOWSTAR
  134.     FOR J = 256 TO 380 STEP 4
  135.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  136.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  137.         SHOWSTAR
  138.         SDELAY 2
  139.         NEXT J
  140.     X = J
  141.     FOR J = X TO 256 STEP -4
  142.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  143.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  144.         SHOWSTAR
  145.         SDELAY 2
  146.     NEXT J
  147.     X = J
  148.     FOR J = X TO 128 STEP -4
  149.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  150.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  151.         SHOWSTAR
  152.         SDELAY 2
  153.     NEXT J
  154.     X = J
  155.     FOR J = X TO 256 STEP 4
  156.         D2SCALE 9, J, J, POINTARRY(0).X, PLOTARRY(0).X
  157.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  158.         SHOWSTAR
  159.         SDELAY 2
  160.     NEXT J
  161.     GETKEY RET$
  162.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  163.         FILLSCREEN 0
  164.         SETVIEW 0, 0, GETMAXX, GETMAXY
  165.         EXIT SUB
  166.     END IF
  167.  
  168.     '*************************************************************************
  169.     '* SHOW D2ROTATE (ABOUT THE CENTER OF THE OBJECT)
  170.     '*************************************************************************
  171.     SETVIEW 0, 0, GETMAXX, 31
  172.     FILLVIEW 0
  173.     SETVIEW 0, 0, GETMAXX, GETMAXY
  174.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  175.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  176.     DRWSTRING 1, 7, 0, A$, 10, 16
  177.     A$ = "Lets do it about the center of the object."
  178.     DRWSTRING 1, 7, 0, A$, 10, 32
  179.     SETVIEW 0, 32, GETMAXX, GETMAXY
  180.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  181.     SHOWSTAR
  182.     FOR J = 0 TO 180
  183.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  184.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  185.         SHOWSTAR
  186.         SDELAY 2
  187.     NEXT J
  188.     FOR J = 180 TO 0 STEP -2
  189.         D2ROTATE 9, 0, 0, J, POINTARRY(0).X, PLOTARRY(0).X
  190.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  191.         SHOWSTAR
  192.         SDELAY 2
  193.     NEXT J
  194.     GETKEY RET$
  195.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  196.         FILLSCREEN 0
  197.         SETVIEW 0, 0, GETMAXX, GETMAXY
  198.         EXIT SUB
  199.     END IF
  200.  
  201.     '*************************************************************************
  202.     '* SHOW D2ROTATE (ABOUT AN ARBITRARY POINT)
  203.     '*************************************************************************
  204.     SETVIEW 0, 0, GETMAXX, 48
  205.     FILLVIEW 0
  206.     SETVIEW 0, 0, GETMAXX, GETMAXY
  207.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  208.     A$ = "D2ROTATE (Points,XOrigin,YOrigin,Angle,InAry,OutAry)"
  209.     DRWSTRING 1, 7, 0, A$, 10, 16
  210.     A$ = "Lets do it about an arbitrary point."
  211.     DRWSTRING 1, 7, 0, A$, 10, 32
  212.     SETVIEW 0, 32, GETMAXX, GETMAXY
  213.     D2TRANSLATE 9, CNTX, CNTY, POINTARRY(0).X, PLOTARRY(0).X
  214.     SHOWSTAR
  215.     FOR J = 0 TO 360 STEP 2
  216.         D2ROTATE 9, 0, SPCNG * 6, J, POINTARRY(0).X, PLOTARRY(0).X
  217.         D2TRANSLATE 9, CNTX, CNTY, PLOTARRY(0).X, PLOTARRY(0).X
  218.         SHOWSTAR
  219.         SDELAY 2
  220.     NEXT J
  221.     SETVIEW 0, 0, GETMAXX, GETMAXY
  222.     GETKEY RET$
  223.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  224.         FILLSCREEN 0
  225.         EXIT SUB
  226.     END IF
  227.     END SUB
  228.     
  229.     
  230.     SUB DO3D (RET$)
  231.     
  232.     '*************************************************************************
  233.     '* SET UP THE TITLE
  234.     '*************************************************************************
  235.     TITLE$ = "DEMO 12: 3D functions"
  236.     PALSET PAL(0), 0, 255
  237.  
  238.     '*************************************************************************
  239.     '* SET UP THE 'HOUSE' PATTERN OF POINTS
  240.     '*************************************************************************
  241.     SETVIEW 0, 0, GETMAXX, GETMAXY
  242.     CNTX = GETMAXX \ 2
  243.     CNTY = ((GETMAXY - 32) \ 2) + 32
  244.     CNTZ = 0
  245.     SPCNG = GETMAXX \ 6
  246.     POINTARRY3D(0).X = -SPCNG
  247.     POINTARRY3D(0).Y = -SPCNG * 2
  248.     POINTARRY3D(0).Z = 0
  249.     POINTARRY3D(1).X = SPCNG
  250.     POINTARRY3D(1).Y = -SPCNG * 2
  251.     POINTARRY3D(1).Z = 0
  252.     POINTARRY3D(2).X = SPCNG
  253.     POINTARRY3D(2).Y = -SPCNG * 2
  254.     POINTARRY3D(2).Z = SPCNG * 2
  255.     POINTARRY3D(3).X = -SPCNG
  256.     POINTARRY3D(3).Y = -SPCNG * 2
  257.     POINTARRY3D(3).Z = SPCNG * 2
  258.     POINTARRY3D(4).X = -SPCNG
  259.     POINTARRY3D(4).Y = SPCNG * 2
  260.     POINTARRY3D(4).Z = 0
  261.     POINTARRY3D(5).X = SPCNG
  262.     POINTARRY3D(5).Y = SPCNG * 2
  263.     POINTARRY3D(5).Z = 0
  264.     POINTARRY3D(6).X = SPCNG
  265.     POINTARRY3D(6).Y = SPCNG * 2
  266.     POINTARRY3D(6).Z = SPCNG * 2
  267.     POINTARRY3D(7).X = -SPCNG
  268.     POINTARRY3D(7).Y = SPCNG * 2
  269.     POINTARRY3D(7).Z = SPCNG * 2
  270.     POINTARRY3D(8).X = 0
  271.     POINTARRY3D(8).Y = -SPCNG * 2
  272.     POINTARRY3D(8).Z = SPCNG * 3
  273.     POINTARRY3D(9).X = 0
  274.     POINTARRY3D(9).Y = SPCNG * 2
  275.     POINTARRY3D(9).Z = SPCNG * 3
  276.     POINTARRY3D(10).X = 0
  277.     POINTARRY3D(10).Z = 0
  278.     POINTARRY3D(10).Y = 0
  279.     POINTARRY3D(11).X = SPCNG * 4
  280.     POINTARRY3D(11).Z = 0
  281.     POINTARRY3D(11).Y = 0
  282.     POINTARRY3D(12).X = 0
  283.     POINTARRY3D(12).Z = 0
  284.     POINTARRY3D(12).Y = SPCNG * 4
  285.     POINTARRY3D(13).X = 0
  286.     POINTARRY3D(13).Z = SPCNG * 4
  287.     POINTARRY3D(13).Y = 0
  288.  
  289.     '*************************************************************************
  290.     '* SHOW D3PROJECT
  291.     '*************************************************************************
  292.     PI! = 4 * ATN(1) / 180
  293.     FILLSCREEN 0
  294.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  295.     A$ = "D3PROJECT (Points,ProjParams,InAry,OutAry)"
  296.     DRWSTRING 1, 7, 0, A$, 10, 16
  297.     SETVIEW 0, 32, GETMAXX, GETMAXY
  298.     HEIGHT = GETMAXY * 8
  299.     Radius = GETMAXX * 30
  300.     J = 110
  301.     PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  302.     PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  303.     PROJ.EYEZ = HEIGHT
  304.     PROJ.SCRD = ((Radius ^ 2 + HEIGHT ^ 2) ^ .5) \ 2
  305.     PROJ.THETA = J
  306.     PROJ.PHI = CINT(ATN(HEIGHT / -Radius) / PI!)
  307.     BYTECOPY POINTARRY3D(0).X, PLAYARRY(0).X, 84
  308.     R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  309.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  310.     SHOWHOUSE
  311.     GETKEY RET$
  312.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  313.         FILLSCREEN 0
  314.         SETVIEW 0, 0, GETMAXX, GETMAXY
  315.         EXIT SUB
  316.     END IF
  317.     FOR J = 112 TO 470 STEP 3
  318.         PROJ.EYEX = FIX(-Radius * COS(J * PI!))
  319.         PROJ.EYEY = FIX(-Radius * SIN(J * PI!))
  320.         PROJ.THETA = J
  321.         R = D3PROJECT(14, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  322.         SHOWHOUSE
  323.         SDELAY 2
  324.     NEXT J
  325.     GETKEY RET$
  326.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  327.         FILLSCREEN 0
  328.         SETVIEW 0, 0, GETMAXX, GETMAXY
  329.         EXIT SUB
  330.     END IF
  331.  
  332.     '*************************************************************************
  333.     '* SHOW D3TRANSLATE
  334.     '*************************************************************************
  335.     SETVIEW 0, 0, GETMAXX, 31
  336.     FILLVIEW 0
  337.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  338.     A$ = "D3TRANSLATE (Points,XTrans,YTrans,ZTrans,InAry,OutAry)"
  339.     DRWSTRING 1, 7, 0, A$, 10, 16
  340.     SETVIEW 0, 32, GETMAXX, GETMAXY
  341.     FOR J = 2 TO 300 STEP 6
  342.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  343.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  344.         SHOWHOUSE
  345.         SDELAY 2
  346.     NEXT J
  347.     X = J
  348.     FOR J = X TO 2 STEP -6
  349.         D3TRANSLATE 10, J, J, 0, POINTARRY3D(0).X, PLAYARRY(0).X
  350.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  351.         SHOWHOUSE
  352.         SDELAY 2
  353.     NEXT J
  354.     GETKEY RET$
  355.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  356.         FILLSCREEN 0
  357.         SETVIEW 0, 0, GETMAXX, GETMAXY
  358.         EXIT SUB
  359.     END IF
  360.  
  361.     '*************************************************************************
  362.     '* SHOW D3SCALE
  363.     '*************************************************************************
  364.     SETVIEW 0, 0, GETMAXX, 31
  365.     FILLVIEW 0
  366.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  367.     A$ = "D3SCALE (Points,XScale,YScale,ZScale,InAry,OutAry)"
  368.     DRWSTRING 1, 7, 0, A$, 10, 16
  369.     SETVIEW 0, 32, GETMAXX, GETMAXY
  370.     FOR J = 256 TO 380 STEP 4
  371.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  372.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  373.         SHOWHOUSE
  374.         SDELAY 2
  375.         NEXT J
  376.     X = J
  377.     FOR J = X TO 256 STEP -4
  378.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  379.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  380.         SHOWHOUSE
  381.         SDELAY 2
  382.     NEXT J
  383.     X = J
  384.     FOR J = X TO 128 STEP -4
  385.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  386.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  387.         SHOWHOUSE
  388.         SDELAY 2
  389.     NEXT J
  390.     X = J
  391.     FOR J = X TO 256 STEP 4
  392.         D3SCALE 10, J, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  393.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  394.         SHOWHOUSE
  395.         SDELAY 2
  396.     NEXT J
  397.     GETKEY RET$
  398.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  399.         FILLSCREEN 0
  400.         SETVIEW 0, 0, GETMAXX, GETMAXY
  401.         EXIT SUB
  402.     END IF
  403.  
  404.     '*************************************************************************
  405.     '* SHOW D2ROTATE (ABOUT THE ORIGIN)
  406.     '*************************************************************************
  407.     SETVIEW 0, 0, GETMAXX, 31
  408.     FILLVIEW 0
  409.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  410.     A$ = "D3ROTATE (Points,XOrigin,YOrigin,ZOrigin,ZAngle,YAngle,XAngle,InAry,OutAry) "
  411.     DRWSTRING 1, 7, 0, A$, 10, 16
  412.     A$ = "Lets do it about the origin."
  413.     DRWSTRING 1, 7, 0, A$, 10, 32
  414.     SETVIEW 0, 32, GETMAXX, GETMAXY
  415.     FOR J = 0 TO 360 STEP 3
  416.         D3ROTATE 10, 0, 0, 0, 0, J, J, POINTARRY3D(0).X, PLAYARRY(0).X
  417.         R = D3PROJECT(10, PROJ.EYEX, PLAYARRY(0).X, PLOTARRY(0).X)
  418.         SHOWHOUSE
  419.         SDELAY 2
  420.     NEXT J
  421.     GETKEY RET$
  422.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  423.         FILLSCREEN 0
  424.         SETVIEW 0, 0, GETMAXX, GETMAXY
  425.         EXIT SUB
  426.     END IF
  427.     END SUB
  428.  
  429.     
  430.     SUB DOPCX (RET$)
  431.     
  432.     '*************************************************************************
  433.     '* SET UP THE TITLE
  434.     '*************************************************************************
  435.     TITLE$ = "DEMO 8: PCX functions"
  436.  
  437.     '*************************************************************************
  438.     '* SHOW PCX GET INFO
  439.     '*************************************************************************
  440.     SETVIEW 0, 0, GETMAXX, GETMAXY
  441.     FILLSCREEN 0
  442.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  443.  
  444. LP:
  445.     A$ = "Please provide the name and full path (if not in the current drive/directory)"
  446.     B$ = "of a PCX file you would like to see..."
  447.     C$ = "Filename:"
  448.     DRWSTRING 1, 7, 0, A$, 10, 64
  449.     DRWSTRING 1, 7, 0, B$, 10, 80
  450.     DRWSTRING 1, 7, 0, C$, 10, 96
  451.     FILENAME$ = "_"
  452.     LENGTH = 0
  453.     EXT = 0
  454.     WHILE EXT = 0
  455.         DRWSTRING 1, 15, 0, FILENAME$, 82, 96
  456.         A$ = ""
  457.         WHILE LEN(A$) < 1 OR LEN(A$) > 1
  458.             A$ = INKEY$
  459.         WEND
  460.         A = ASC(A$)
  461.         IF A > 31 AND A < 128 THEN
  462.             FILENAME$ = LEFT$(FILENAME$, LENGTH) + A$ + "_"
  463.             LENGTH = LENGTH + 1
  464.         ELSE
  465.             IF A = 8 AND LENGTH > 0 THEN
  466.                 DRWSTRING 1, 15, 0, STRING$(LENGTH + 1, 32), 82, 96
  467.                 LENGTH = LENGTH - 1
  468.                 FILENAME$ = LEFT$(FILENAME$, LENGTH) + "_"
  469.             ELSEIF A = 13 THEN
  470.                 EXT = 1
  471.             END IF
  472.         END IF
  473.     WEND
  474.     FILENAME$ = LEFT$(FILENAME$, LENGTH)
  475.     IF LEN(FILENAME$) < 1 THEN
  476.         EXIT SUB '* OOPS! NO NAME GIVEN SO LET'S JUST BAIL OUT!
  477.     END IF
  478.     SHOWPCX RET$, FILENAME$
  479.     IF RET$ = "S" OR RET$ = "Q" THEN
  480.         FILLSCREEN 0
  481.         EXIT SUB
  482.     END IF
  483.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  484.     A$ = "Would you like to see another (Y/N) ?"
  485.     DRWSTRING 1, 7, 0, A$, 10, 64
  486.     EXT = 0
  487.     SOUND 700, .75
  488.     WHILE EXT = 0
  489.         A$ = ""
  490.         WHILE A$ = ""
  491.             A$ = INKEY$
  492.         WEND
  493.         IF A$ = "Y" OR A$ = "y" THEN
  494.             GOTO LP
  495.         ELSEIF A$ = "N" OR A$ = "n" THEN
  496.             EXT = 1
  497.         ELSE
  498.             SOUND 100, 5
  499.         END IF
  500.     WEND
  501.     FILLSCREEN 0
  502.     END SUB
  503.  
  504.     
  505.     SUB DOJOYSTICK (RET$)
  506.     
  507.     '*************************************************************************
  508.     '* SET UP THE TITLE
  509.     '*************************************************************************
  510.     TITLE$ = "DEMO 10: Joystick functions"
  511.     PALSET PAL(0), 0, 255
  512.     FILLSCREEN 0
  513.     SETVIEW 0, 0, GETMAXX, GETMAXY
  514.  
  515.     '*************************************************************************
  516.     '* CHECK TO SEE IF WE HAVE A JOYSTICK SO WE CAN DO THE JOYSTICK DEMO
  517.     '*************************************************************************
  518.     JOYSTICK = WHICHJOYSTICK
  519.     IF JOYSTICK < 1 THEN
  520.         SOUND 100, 5
  521.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  522.         A$ = "Sorry, No Joystick Detected...Can Not Do The Joystick Demo."
  523.         DRWSTRING 1, 7, 0, A$, 10, 16
  524.         WHILE INKEY$ = ""
  525.         WEND
  526.         FILLSCREEN 0
  527.         EXIT SUB
  528.     END IF
  529.  
  530.     '*************************************************************************
  531.     '* SHOW JOYSTICKINFO (HERE WE DO SOME JOYSTICK CALIBRATION)
  532.     '*************************************************************************
  533.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  534.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  535.     DRWSTRING 1, 7, 0, A$, 10, 16
  536.     SETVIEW 0, 0, GETMAXX, GETMAXY
  537.     SELECT CASE JOYSTICK
  538.         CASE = 1
  539.             A$ = "Please Move Joystick A As Far As It Will Go In All Directions"
  540.         CASE = 2
  541.             A$ = "Please Move Joystick B As Far As It Will Go In All Directions"
  542.         CASE = 3
  543.             A$ = "Please Move Both Joystick A And B As Far As They Will Go In All Directions"
  544.     END SELECT
  545.     DRWSTRING 1, 7, 0, A$, 10, 32
  546.     A$ = "And Then Press A Key..."
  547.     DRWSTRING 1, 7, 0, A$, 10, 48
  548.     SOUND 700, .75
  549.     GETMAXXA = -1
  550.     MAXYA = -1
  551.     MINXA = 10000
  552.     MINYA = 10000
  553.     GETMAXXB = -1
  554.     MAXYB = -1
  555.     MINXB = 10000
  556.     MINYB = 10000
  557.     A$ = ""
  558.     WHILE A$ = ""
  559.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  560.         IF JAX > GETMAXXA THEN
  561.             GETMAXXA = JAX
  562.         END IF
  563.         IF JAX < MINXA THEN
  564.             MINXA = JAX
  565.         END IF
  566.         IF JAY > MAXYA THEN
  567.             MAXYA = JAY
  568.         END IF
  569.         IF JAY < MINYA THEN
  570.             MINYA = JAY
  571.         END IF
  572.         IF JBX > GETMAXXB THEN
  573.             GETMAXXB = JBX
  574.         END IF
  575.         IF JBX < MINXB THEN
  576.             MINXB = JBX
  577.         END IF
  578.         IF JBY > MAXYB THEN
  579.             MAXYB = JBY
  580.         END IF
  581.         IF JBY < MINYB THEN
  582.             MINYB = JBY
  583.         END IF
  584.         A$ = INKEY$
  585.     WEND
  586.  
  587.     '*************************************************************************
  588.     '* CALCULATE THE CENTER AND STUFF...
  589.     '*************************************************************************
  590.     SPCNG = GETMAXX \ 7
  591.     DIST = SPCNG * 2
  592.     X1 = SPCNG \ 2
  593.     Y1 = SPCNG \ 2 + 32
  594.     X2 = X1 + DIST
  595.     Y2 = Y1 + DIST
  596.     X4 = GETMAXX - SPCNG
  597.     Y4 = Y2
  598.     X3 = X4 - DIST
  599.     Y3 = Y1
  600.     CNTAX = (X2 - X1) / 2 + X1
  601.     CNTAY = (Y2 - Y1) / 2 + Y1
  602.     CNTBX = (X4 - X3) / 2 + X3
  603.     CNTBY = (Y4 - Y3) / 2 + Y3
  604.     RANGEXA = GETMAXXA - MINXA
  605.     RANGEYA = MAXYA - MINYA
  606.     RANGEXB = GETMAXXB - MINXB
  607.     RANGEYB = MAXYB - MINYB
  608.     JABAX = (X2 - X1) \ 4 + X1 - 16
  609.     JABAY = (SPCNG \ 4) + Y2 - 6
  610.     JABBX = X2 - (X2 - X1) \ 4 - 16
  611.     JABBY = (SPCNG \ 4) + Y2 - 6
  612.     JBBAX = (X4 - X3) \ 4 + X3 - 16
  613.     JBBAY = (SPCNG \ 4) + Y4 - 6
  614.     JBBBX = X4 - (X4 - X3) \ 4 - 16
  615.     JBBBY = (SPCNG \ 4) + Y4 - 6
  616.  
  617.     '*************************************************************************
  618.     '* LETS MOVE IT (OR THEM) AROUND
  619.     '*************************************************************************
  620.     SETVIEW 0, 0, GETMAXX, 64
  621.     FILLVIEW 0
  622.     SETVIEW 0, 0, GETMAXX, GETMAXY
  623.     IF (JOYSTICK AND 1) = 1 THEN
  624.         DRWBOX 1, 15, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  625.         DRWBOX 1, 15, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  626.         DRWLINE 1, 15, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  627.         OAX = CNTAX
  628.         OAY = CNTAY
  629.         DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  630.     ELSE
  631.         DRWBOX 1, 8, X1 - 1, Y1 - 1, X2 + 1, Y2 + 1
  632.         DRWBOX 1, 8, X1 - 1, Y2 + 1, X2 + 1, Y2 + SPCNG \ 2
  633.         DRWLINE 1, 8, (X2 - X1) \ 2 + X1, Y2 + 1, (X2 - X1) \ 2 + X1, Y2 + SPCNG \ 2
  634.     END IF
  635.     IF (JOYSTICK AND 2) = 2 THEN
  636.         DRWBOX 1, 15, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  637.         DRWBOX 1, 15, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  638.         DRWLINE 1, 15, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  639.         OBX = CNTBX
  640.         OBY = CNTBY
  641.         DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  642.     ELSE
  643.         DRWBOX 1, 8, X3 - 1, Y3 - 1, X4 + 1, Y4 + 1
  644.         DRWBOX 1, 8, X3 - 1, Y4 + 1, X4 + 1, Y4 + SPCNG \ 2
  645.         DRWLINE 1, 8, (X4 - X3) \ 2 + X3, Y4 + 1, (X4 - X3) \ 2 + X3, Y4 + SPCNG \ 2
  646.     END IF
  647.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  648.     A$ = "JOYSTICKINFO (JAX,JAY,JAButs,JBX,JBY,JBButs)"
  649.     DRWSTRING 1, 7, 0, A$, 10, 16
  650.     SETVIEW 0, 32, GETMAXX, GETMAXY
  651.     A$ = ""
  652.     WHILE A$ = ""
  653.         JOYSTICKINFO JAX, JAY, JAButs, JBX, JBY, JBButs
  654.         IF (JOYSTICK AND 1) = 1 THEN
  655.             SETVIEW X1, Y1, X2, Y2
  656.             JAX = JAX - MINXA
  657.             JAX = JAX / RANGEXA * DIST + X1
  658.             JAY = JAY - MINYA
  659.             JAY = JAY / RANGEYA * DIST + Y1
  660.             DRWLINE 1, 0, CNTAX, CNTAY, OAX, OAY
  661.             OAX = JAX
  662.             OAY = JAY
  663.             DRWLINE 1, 10, CNTAX, CNTAY, OAX, OAY
  664.             SETVIEW 0, 0, GETMAXX, GETMAXY
  665.             IF (JAButs AND 1) = 1 THEN
  666.                 DRWSTRING 1, 10, 0, "ButA", JABAX, JABAY
  667.             ELSE
  668.                 DRWSTRING 1, 8, 0, "ButA", JABAX, JABAY
  669.             END IF
  670.             IF (JAButs AND 2) = 2 THEN
  671.                 DRWSTRING 1, 10, 0, "ButB", JABBX, JABBY
  672.             ELSE
  673.                 DRWSTRING 1, 8, 0, "ButB", JABBX, JABBY
  674.             END IF
  675.         END IF
  676.         IF (JOYSTICK AND 2) = 2 THEN
  677.             SETVIEW X3, Y3, X4, Y4
  678.             JBX = JBX - MINXB
  679.             JBX = JBX / RANGEXB * DIST + X3
  680.             JBY = JBY - MINYB
  681.             JBY = JBY / RANGEYB * DIST + Y3
  682.             DRWLINE 1, 0, CNTBX, CNTBY, OBX, OBY
  683.             OBX = JBX
  684.             OBY = JBY
  685.             DRWLINE 1, 10, CNTBX, CNTBY, OBX, OBY
  686.             SETVIEW 0, 0, GETMAXX, GETMAXY
  687.             IF (JBButs AND 1) = 1 THEN
  688.                 DRWSTRING 1, 10, 0, "ButA", JBBAX, JBBAY
  689.             ELSE
  690.                 DRWSTRING 1, 8, 0, "ButA", JBBAX, JBBAY
  691.             END IF
  692.             IF (JBButs AND 2) = 2 THEN
  693.                 DRWSTRING 1, 10, 0, "ButB", JBBBX, JBBBY
  694.             ELSE
  695.                 DRWSTRING 1, 8, 0, "ButB", JBBBX, JBBBY
  696.             END IF
  697.         END IF
  698.         A$ = INKEY$
  699.     WEND
  700.     RET$ = A$
  701.     IF RET$ = "q" THEN
  702.         RET$ = "Q"
  703.     END IF
  704.     IF RET$ = "s" THEN
  705.         RET$ = "S"
  706.     END IF
  707.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  708.         FILLSCREEN 0
  709.         SETVIEW 0, 0, GETMAXX, GETMAXY
  710.         EXIT SUB
  711.     END IF
  712.     SETVIEW 0, 0, GETMAXX, GETMAXY
  713.     END SUB
  714.  
  715.     
  716.     SUB DOMOUSE (RET$)
  717.     
  718.     '*************************************************************************
  719.     '* SET UP THE TITLE
  720.     '*************************************************************************
  721.     TITLE$ = "DEMO 9: Mouse functions"
  722.     FILLSCREEN 0
  723.     PALSET PAL(0), 0, 255
  724.     SETVIEW 0, 0, GETMAXX, GETMAXY
  725.  
  726.     '*************************************************************************
  727.     '* CHECK TO SEE IF WE HAVE A MOUSE SO WE CAN DO THE MOUSE DEMO
  728.     '*************************************************************************
  729.     MOUSE = WHICHMOUSE
  730.     IF MOUSE < 1 THEN
  731.         SOUND 100, 5
  732.         DRWSTRING 1, 7, 0, TITLE$, 10, 0
  733.         A$ = "Sorry, No Mouse Detected...Can Not Do The Mouse Demo."
  734.         DRWSTRING 1, 7, 0, A$, 10, 16
  735.         WHILE INKEY$ = ""
  736.         WEND
  737.         FILLSCREEN 0
  738.         EXIT SUB
  739.     ELSE
  740.         Colr = 16
  741.         FOR I = 0 TO GETMAXX \ 2
  742.             DRWCIRCLE 1, Colr, GETMAXX \ 4 + I, GETMAXY \ 2, GETMAXY \ 5
  743.             Colr = Colr + 2
  744.             IF Colr > 255 THEN
  745.                 Colr = 16
  746.             END IF
  747.         NEXT I
  748.     END IF
  749.  
  750.     '*************************************************************************
  751.     '* SHOW MOUSESHOW
  752.     '*************************************************************************
  753.     SETVIEW 0, 0, GETMAXX, 31
  754.     FILLVIEW 0
  755.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  756.     A$ = "MOUSESHOW ()"
  757.     DRWSTRING 1, 7, 0, A$, 10, 16
  758.     SETVIEW 0, 32, GETMAXX, GETMAXY
  759.     MOUSEENTER '*MUST BE CALLED FIRST TO ENABLE MOUSE FUNCTIONS
  760.     MOUSESHOW
  761.     GETKEY RET$
  762.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  763.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  764.         FILLSCREEN 0
  765.         SETVIEW 0, 0, GETMAXX, GETMAXY
  766.         EXIT SUB
  767.     END IF
  768.  
  769.     '*************************************************************************
  770.     '* SHOW MOUSESTATUS
  771.     '*************************************************************************
  772.     MOUSEHIDE
  773.     SETVIEW 0, 0, GETMAXX, 31
  774.     FILLVIEW 0
  775.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  776.     A$ = "MOUSESTATUS (Xloc,Yloc,MButs)"
  777.     DRWSTRING 1, 7, 0, A$, 10, 16
  778.     MOUSESHOW
  779.     SETVIEW 0, 32, GETMAXX, GETMAXY
  780.     A$ = ""
  781.     SOUND 700, .75
  782.     WHILE A$ = ""
  783.         MOUSESTATUS X, Y, MButs
  784.         IF (MButs AND 1) = 1 THEN
  785.             LB = 1
  786.         ELSE
  787.             LB = 0
  788.         END IF
  789.         IF (MButs AND 2) = 2 THEN
  790.             RB = 1
  791.         ELSE
  792.             RB = 0
  793.         END IF
  794.         IF (MButs AND 4) = 4 THEN
  795.             CB = 1
  796.         ELSE
  797.             CB = 0
  798.         END IF
  799.         D$ = "X=" + STR$(X)
  800.         L = LEN(D$)
  801.         IF L < 10 THEN
  802.             D$ = D$ + STRING$(8 - L, 32)
  803.         END IF
  804.         D$ = D$ + "Y=" + STR$(Y)
  805.         L = LEN(D$)
  806.         IF L < 20 THEN
  807.             D$ = D$ + STRING$(16 - L, 32)
  808.         END IF
  809.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  810.         DRWSTRING 1, 15, 8, D$, 10, 32
  811.         A$ = INKEY$
  812.     WEND
  813.     RET$ = A$
  814.     IF RET$ = "q" THEN
  815.         RET$ = "Q"
  816.     END IF
  817.     IF RET$ = "s" THEN
  818.         RET$ = "S"
  819.     END IF
  820.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  821.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  822.         FILLSCREEN 0
  823.         SETVIEW 0, 0, GETMAXX, GETMAXY
  824.         EXIT SUB
  825.     END IF
  826.  
  827.     '*************************************************************************
  828.     '* SHOW MOUSEHIDE
  829.     '*************************************************************************
  830.     MOUSEHIDE
  831.     SETVIEW 0, 0, GETMAXX, 31
  832.     FILLVIEW 0
  833.     SETVIEW 0, 0, GETMAXX, GETMAXY
  834.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  835.     A$ = "MOUSEHIDE ()"
  836.     DRWSTRING 1, 7, 0, A$, 10, 16
  837.     SETVIEW 0, 32, GETMAXX, GETMAXY
  838.     A$ = ""
  839.     SOUND 700, .75
  840.     WHILE A$ = ""
  841.         MOUSESTATUS X, Y, MButs
  842.         IF (MButs AND 1) = 1 THEN
  843.             LB = 1
  844.         ELSE
  845.             LB = 0
  846.         END IF
  847.         IF (MButs AND 2) = 2 THEN
  848.             RB = 1
  849.         ELSE
  850.             RB = 0
  851.         END IF
  852.         IF (MButs AND 4) = 4 THEN
  853.             CB = 1
  854.         ELSE
  855.             CB = 0
  856.         END IF
  857.         D$ = "X=" + STR$(X)
  858.         L = LEN(D$)
  859.         IF L < 10 THEN
  860.             D$ = D$ + STRING$(8 - L, 32)
  861.         END IF
  862.         D$ = D$ + "Y=" + STR$(Y)
  863.         L = LEN(D$)
  864.         IF L < 20 THEN
  865.             D$ = D$ + STRING$(16 - L, 32)
  866.         END IF
  867.         D$ = D$ + "LB=" + STR$(LB) + "  CB=" + STR$(CB) + "  RB=" + STR$(RB)
  868.         DRWSTRING 1, 15, 8, D$, 10, 32
  869.         A$ = INKEY$
  870.     WEND
  871.     MOUSESHOW
  872.     RET$ = A$
  873.     IF RET$ = "q" THEN
  874.         RET$ = "Q"
  875.     END IF
  876.     IF RET$ = "s" THEN
  877.         RET$ = "S"
  878.     END IF
  879.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  880.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  881.         FILLSCREEN 0
  882.         SETVIEW 0, 0, GETMAXX, GETMAXY
  883.         EXIT SUB
  884.     END IF
  885.  
  886.     '*************************************************************************
  887.     '* SHOW MOUSERANGESET
  888.     '*************************************************************************
  889.     MOUSEHIDE
  890.     SETVIEW 0, 0, GETMAXX, 48
  891.     FILLVIEW 0
  892.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  893.     A$ = "MOUSERANGESET (X1,Y1,X2,Y2)"
  894.     DRWSTRING 1, 7, 0, A$, 10, 16
  895.     SETVIEW 0, 0, GETMAXX, GETMAXY
  896.     SPCNG = (GETMAXY - 32) \ 3
  897.     X1 = SPCNG
  898.     Y1 = 32 + SPCNG
  899.     X2 = GETMAXX - SPCNG
  900.     Y2 = GETMAXY - SPCNG
  901.     DRWBOX 1, 15, X1, Y1, X2, Y2
  902.     MOUSESHOW
  903.     MOUSERANGESET X1, Y1, X2, Y2
  904.     GETKEY RET$
  905.     MOUSERANGESET 0, 0, GETMAXX, GETMAXY
  906.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  907.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  908.         FILLSCREEN 0
  909.         SETVIEW 0, 0, GETMAXX, GETMAXY
  910.         EXIT SUB
  911.     END IF
  912.     
  913.     '*************************************************************************
  914.     '* SHOW MOUSECURSORSET USE THE MAGNIFIER
  915.     '*************************************************************************
  916.     SETVIEW 0, 0, GETMAXX, 31
  917.     FILLVIEW 0
  918.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  919.     A$ = "MOUSECURSORSET (MouseCursor?)"
  920.     DRWSTRING 1, 7, 0, A$, 10, 16
  921.     SETVIEW 0, 32, GETMAXX, GETMAXY
  922.     MOUSECURSORSET MAGMOUSECURSOR(0)
  923.     GETKEY RET$
  924.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  925.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  926.         FILLSCREEN 0
  927.         SETVIEW 0, 0, GETMAXX, GETMAXY
  928.         EXIT SUB
  929.     END IF
  930.  
  931.     '*************************************************************************
  932.     '* SHOW MOUSECURSORSET USE THE BIG ARROW
  933.     '*************************************************************************
  934.     SETVIEW 0, 32, GETMAXX, GETMAXY
  935.     MOUSECURSORSET BIGMOUSECURSOR(0)
  936.     GETKEY RET$
  937.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  938.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  939.         FILLSCREEN 0
  940.         SETVIEW 0, 0, GETMAXX, GETMAXY
  941.         EXIT SUB
  942.     END IF
  943.  
  944.     '*************************************************************************
  945.     '* SHOW MOUSECURSORSET USE THE STOPWATCH
  946.     '*************************************************************************
  947.     MOUSECURSORSET STWMOUSECURSOR(0)
  948.     GETKEY RET$
  949.     IF (RET$ = "S") OR (RET$ = "Q") THEN
  950.         MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  951.         FILLSCREEN 0
  952.         SETVIEW 0, 0, GETMAXX, GETMAXY
  953.         EXIT SUB
  954.     END IF
  955.  
  956.     '*************************************************************************
  957.     '* SHOW MOUSECURSORDEFAULT
  958.     '*************************************************************************
  959.     MOUSEHIDE
  960.     SETVIEW 0, 0, GETMAXX, 31
  961.     FILLVIEW 0
  962.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  963.     A$ = "MOUSECURSORDEFAULT ()"
  964.     DRWSTRING 1, 7, 0, A$, 10, 16
  965.     MOUSESHOW
  966.     SETVIEW 0, 32, GETMAXX, GETMAXY
  967.     MOUSECURSORDEFAULT
  968.     GETKEY RET$
  969.     MOUSEEXIT '*MUST BE CALLED TO DISABLE MOUSE FUNCTIONS
  970.     FILLSCREEN 0
  971.     SETVIEW 0, 0, GETMAXX, GETMAXY
  972.     END SUB
  973.  
  974.     
  975.     SUB SHOWPCX (RET$, FILENAME$)
  976.     
  977.     '*************************************************************************
  978.     '* THIS ROUTINE IS CALLED BY DOPCX
  979.     '*************************************************************************
  980.     TITLE$ = "DEMO 8: PCX functions"
  981.  
  982.     '*************************************************************************
  983.     '* SHOW PCX GET INFO
  984.     '*************************************************************************
  985.     FILLSCREEN 0
  986.     DRWSTRING 1, 7, 0, TITLE$, 10, 0
  987.     A$ = "PCXGETINFO(FileName$,PCXXSize,PCXYSize,NumColors,Palette)"
  988.     DRWSTRING 1, 7, 0, A$, 10, 16
  989.     PCXFILENAME$ = FILENAME$
  990.     OK = PCXGETINFO(PCXFILENAME$, XSIZE, YSIZE, NUMCOL, PCXPAL(0))
  991.     MINCOLOR = 0
  992.     MAXCOLOR = 0
  993.     MINCOLORBRITENESS& = (255^2) * 3
  994.     MAXCOLORBRITENESS& = 0
  995.     IF OK = 1 THEN
  996.         '*********************************************************************
  997.         '* WE NEED TO CHECK THE PCX COLOR PALETTE ENTRIES TO SEE IF ANY COLORS
  998.         '* ARE GREATER THE SIX BITS IN LENGTH AS THE VGA COLOR PALETTE
  999.         '* REGISTERS ARE ONLY SIX BITS WIDE. WE ALSO LOOK FOR THE BRIGHTEST
  1000.         '* AND DARKEST COLORS TO USE AS OUR TEXT AND BACKGROUND COLORS
  1001.         '*********************************************************************
  1002.         FIXIT = 0
  1003.         FOR I = 0 TO NUMCOL - 1
  1004.             IF PCXPAL(I).R > 63 THEN
  1005.                 FIXIT = 1
  1006.             END IF
  1007.             IF PCXPAL(I).G > 63 THEN
  1008.                 FIXIT = 1
  1009.             END IF
  1010.             IF PCXPAL(I).B > 63 THEN
  1011.                 FIXIT = 1
  1012.             END IF
  1013.             COLORBRIGHTNESS& = PCXPAL(I).R^2 + PCXPAL(I).G^2 + PCXPAL(I).B^2
  1014.             '* FIND THE DARKEST COLOR FOR THE BACKGROUND
  1015.             IF COLORBRIGHTNESS& < MINCOLORBRITENESS& THEN  
  1016.                 MINCOLORBRITENESS& = COLORBRIGHTNESS&
  1017.                 MINCOLOR = I
  1018.             END IF
  1019.             '* FIND THE BRIGHTEST COLOR FOR THE TEXT
  1020.             IF COLORBRIGHTNESS& > MAXCOLORBRITENESS& THEN
  1021.                 MAXCOLORBRITENESS& = COLORBRIGHTNESS&      
  1022.                 MAXCOLOR = I
  1023.             END IF
  1024.         NEXT I
  1025.         '*********************************************************************
  1026.         '* IF THE PCX USES 8 BIT COLOR THEN WE SHIFT EACH COLOR ENTRY RIGHT
  1027.         '* BY 2 BITS (THIS REDUCES IT TO 6 BITS OF COLOR)
  1028.         '*********************************************************************
  1029.         IF FIXIT = 1 THEN
  1030.             FOR A = 0 TO NUMCOL
  1031.                 SHIFT RIGHT PCXPAL(A).R, 2
  1032.                 SHIFT RIGHT PCXPAL(A).G, 2
  1033.                 SHIFT RIGHT PCXPAL(A).B, 2
  1034.             NEXT A
  1035.         END IF
  1036.         '*********************************************************************
  1037.         '* IF THE PCX HAS A PALETTE OF 128 COLORS OR LESS THEN WE CAN USE
  1038.         '* OUR OWN COLORS FOR THE TEXT AND BACKGROUND
  1039.         '*********************************************************************
  1040.         IF NUMCOL < 128 THEN
  1041.             MINCOLOR = 254
  1042.             PCXPAL(MINCOLOR).R = 0   '* THIS IS THE COLOR BLACK
  1043.             PCXPAL(MINCOLOR).G = 0
  1044.             PCXPAL(MINCOLOR).B = 0
  1045.             MAXCOLOR = 255
  1046.             PCXPAL(MAXCOLOR).R = 255 '* THIS IS THE COLOR BRIGHT WHITE
  1047.             PCXPAL(MAXCOLOR).G = 255
  1048.             PCXPAL(MAXCOLOR).B = 255
  1049.         END IF
  1050.         A$ = "'" + PCXFILENAME$ + "' is identified as a v3.0 PVX file."
  1051.         DRWSTRING 1, 15, 0, A$, 10, 64
  1052.         A$ = "Dimensions are:" + STR$(XSIZE) + " pixels wide and" + STR$(YSIZE) + " pixels high"
  1053.         DRWSTRING 1, 15, 0, A$, 10, 80
  1054.         A$ = "Number of colors:" + STR$(NUMCOL)
  1055.         DRWSTRING 1, 15, 0, A$, 10, 96
  1056.         GETKEY RET$
  1057.         IF (RET$ = "S") OR (RET$ = "Q") THEN
  1058.             FILLSCREEN 0
  1059.             SETVIEW 0, 0, GETMAXX, GETMAXY
  1060.             EXIT SUB
  1061.         END IF
  1062.  
  1063.         '*********************************************************************
  1064.         '* SHOW PCX GETPUT
  1065.         '*********************************************************************
  1066.         PALSET PCXPAL(0), 0, 255
  1067.         OVERSCANSET MINCOLOR
  1068.         FILLSCREEN MINCOLOR
  1069.         DRWSTRING 1, MAXCOLOR, MINCOLOR, TITLE$, 10, 0
  1070.         A$ = "PCXPUT(Mode,X,Y,FileName$)"
  1071.         DRWSTRING 1, MAXCOLOR, MINCOLOR, A$, 10, 16
  1072.         SETVIEW 0, 32, GETMAXX, GETMAXY
  1073.         Xloc = (GETMAXX \ 2) - (XSIZE \ 2)
  1074.         Yloc = ((GETMAXY - 32) \ 2) - (YSIZE \ 2) + 32
  1075.         OK = PCXPUT(1, Xloc, Yloc, PCXFILENAME$)
  1076.         IF OK <> 1 THEN
  1077.         '*********************************************************************
  1078.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1079.         '********************************************************************
  1080.             SOUND 100, 5
  1081.             A$ = "The file '" + PCXFILENAME$ + "' "
  1082.             B$ = ""
  1083.             SELECT CASE OK
  1084.                 CASE = 0
  1085.                     A$ = A$ + "does not exist in the specified directory"
  1086.                     B$ = " or there is some disk I/O problem."
  1087.                 CASE = -1
  1088.                     A$ = A$ + "is not a v3.0 PCX file."
  1089.                 CASE = -2
  1090.                     A$ = A$ + "is not run length encoded."
  1091.                 CASE = -3
  1092.                     A$ = A$ + "has some general error."
  1093.             END SELECT
  1094.             DRWSTRING 1, MINCOLOR, MAXCOLOR, A$, 10, 64
  1095.             DRWSTRING 1, MINCOLOR, MAXCOLOR, B$, 10, 80
  1096.         END IF
  1097.     ELSE
  1098.         '*********************************************************************
  1099.         '* OOPSTHIS FILE HAS SOME PROBLEM
  1100.         '*********************************************************************
  1101.         SOUND 100, 5
  1102.         A$ = "The file '" + PCXFILENAME$ + "' "
  1103.         B$ = ""
  1104.         SELECT CASE OK
  1105.             CASE = 0
  1106.                 A$ = A$ + "does not exist in the specified directory"
  1107.                 B$ = " or there is some disk I/O problem."
  1108.             CASE = -1
  1109.                 A$ = A$ + "is not a v3.0 PCX file."
  1110.             CASE = -2
  1111.                 A$ = A$ + "is not run length encoded."
  1112.             CASE = -3
  1113.                 A$ = A$ + "has some general error."
  1114.         END SELECT
  1115.         DRWSTRING 1, 15, 0, A$, 10, 64
  1116.         DRWSTRING 1, 15, 0, B$, 10, 80
  1117.     END IF
  1118.     GETKEY RET$
  1119.     PALSET ORGPAL(0), 0, 255
  1120.     OVERSCANSET 0
  1121.     FILLSCREEN 0
  1122.     SETVIEW 0, 0, GETMAXX, GETMAXY
  1123.     END SUB
  1124.  
  1125.     
  1126.     SUB SHOWHOUSE
  1127.     
  1128.     SHARED OPLOTARRY()
  1129.     SHARED PLOTARRY()
  1130.  
  1131.     '*************************************************************************
  1132.     '* THIS ROUTINE IS CALLED BY DO3D
  1133.     '*************************************************************************
  1134.  
  1135.     '*************************************************************************
  1136.     '* ERASE THE OLD HOUSE
  1137.     '*************************************************************************
  1138.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(11).X, OPLOTARRY(11).Y
  1139.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(12).X, OPLOTARRY(12).Y
  1140.     DRWLINE 1, 0, OPLOTARRY(10).X, OPLOTARRY(10).Y, OPLOTARRY(13).X, OPLOTARRY(13).Y
  1141.     FOR I = 0 TO 2
  1142.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1143.         DRWLINE 1, 0, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y, OPLOTARRY(I + 4 + 1).X, OPLOTARRY(I + 4 + 1).Y
  1144.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 4).X, OPLOTARRY(I + 4).Y
  1145.     NEXT I
  1146.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1147.     DRWLINE 1, 0, OPLOTARRY(0).X, OPLOTARRY(0).Y, OPLOTARRY(3).X, OPLOTARRY(3).Y
  1148.     DRWLINE 1, 0, OPLOTARRY(4).X, OPLOTARRY(4).Y, OPLOTARRY(7).X, OPLOTARRY(7).Y
  1149.     DRWLINE 1, 0, OPLOTARRY(3).X, OPLOTARRY(3).Y, OPLOTARRY(8).X, OPLOTARRY(8).Y
  1150.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(2).X, OPLOTARRY(2).Y
  1151.     DRWLINE 1, 0, OPLOTARRY(7).X, OPLOTARRY(7).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1152.     DRWLINE 1, 0, OPLOTARRY(9).X, OPLOTARRY(9).Y, OPLOTARRY(6).X, OPLOTARRY(6).Y
  1153.     DRWLINE 1, 0, OPLOTARRY(8).X, OPLOTARRY(8).Y, OPLOTARRY(9).X, OPLOTARRY(9).Y
  1154.  
  1155.     '*************************************************************************
  1156.     '* DRAW THE NEW HOUSE
  1157.     '*************************************************************************
  1158.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(11).X, PLOTARRY(11).Y
  1159.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(12).X, PLOTARRY(12).Y
  1160.     DRWLINE 1, 8, PLOTARRY(10).X, PLOTARRY(10).Y, PLOTARRY(13).X, PLOTARRY(13).Y
  1161.     FOR I = 0 TO 2
  1162.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1163.         DRWLINE 1, 10, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y, PLOTARRY(I + 4 + 1).X, PLOTARRY(I + 4 + 1).Y
  1164.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 4).X, PLOTARRY(I + 4).Y
  1165.     NEXT I
  1166.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1167.     DRWLINE 1, 10, PLOTARRY(0).X, PLOTARRY(0).Y, PLOTARRY(3).X, PLOTARRY(3).Y
  1168.     DRWLINE 1, 10, PLOTARRY(4).X, PLOTARRY(4).Y, PLOTARRY(7).X, PLOTARRY(7).Y
  1169.     DRWLINE 1, 10, PLOTARRY(3).X, PLOTARRY(3).Y, PLOTARRY(8).X, PLOTARRY(8).Y
  1170.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(2).X, PLOTARRY(2).Y
  1171.     DRWLINE 1, 10, PLOTARRY(7).X, PLOTARRY(7).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1172.     DRWLINE 1, 10, PLOTARRY(9).X, PLOTARRY(9).Y, PLOTARRY(6).X, PLOTARRY(6).Y
  1173.     DRWLINE 1, 10, PLOTARRY(8).X, PLOTARRY(8).Y, PLOTARRY(9).X, PLOTARRY(9).Y
  1174.  
  1175.     '*************************************************************************
  1176.     '* SAVE THE OLD POINTS
  1177.     '*************************************************************************
  1178.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 56
  1179.     END SUB
  1180.  
  1181.     
  1182.     SUB SHOWSTAR
  1183.     
  1184.     SHARED OPLOTARRY()
  1185.     SHARED PLOTARRY()
  1186.  
  1187.     '*************************************************************************
  1188.     '* THIS ROUTINE IS CALLED BY DO2D
  1189.     '*************************************************************************
  1190.  
  1191.     '*************************************************************************
  1192.     '* ERASE THE OLD STAR
  1193.     '*************************************************************************
  1194.     FOR I = 0 TO 7
  1195.         DRWLINE 1, 0, OPLOTARRY(I).X, OPLOTARRY(I).Y, OPLOTARRY(I + 1).X, OPLOTARRY(I + 1).Y
  1196.     NEXT I
  1197.  
  1198.     '*************************************************************************
  1199.     '* DRAW THE NEW STAR
  1200.     '*************************************************************************
  1201.     FOR I = 0 TO 7
  1202.         DRWLINE 1, 10, PLOTARRY(I).X, PLOTARRY(I).Y, PLOTARRY(I + 1).X, PLOTARRY(I + 1).Y
  1203.     NEXT I
  1204.  
  1205.     '*************************************************************************
  1206.     '* SAVE THE OLD POINTS
  1207.     '*************************************************************************
  1208.     BYTECOPY PLOTARRY(0).X, OPLOTARRY(0).X, 36
  1209.     END SUB
  1210.  
  1211.